home *** CD-ROM | disk | FTP | other *** search
/ Just Call Me Internet / Just Call Me Internet.iso / prog / atari / gfa / list_src / list_233.gfa (.txt) next >
Encoding:
GFA-BASIC Atari  |  1994-11-24  |  42.3 KB  |  2,238 lines

  1. ' Version 2.33 - 24.11.94
  2. version$="2.33"
  3. ~FRE(0)
  4. '
  5. ON BREAK GOSUB breakout
  6. ON ERROR GOSUB error_trapping
  7. '
  8. initialize
  9. cmd_line
  10. parse_ctl_file
  11. ' logit!=FALSE
  12. add_header
  13. add_magic
  14. @clear
  15. paths_to_search
  16. logo
  17. prep_pack
  18. took_how_long
  19. finish(0)
  20. > PROCEDURE initialize
  21.   CLS
  22.   HIDEM
  23.   t%=TIMER
  24.   today%=GEMDOS(42)
  25.   max%=0
  26.   min%=99999999
  27.   md%=0
  28.   mf%=0
  29.   lc%=6
  30.   tp%=10
  31.   tmpgrp%=10
  32.   tc%=0
  33.   numareas&=0
  34.   gtp%=50
  35.   number_areas%=250
  36.   max_files%=2000
  37.   gnum%=25
  38.   lf$=CHR$(10)
  39.   rn!=TRUE
  40.   grn!=TRUE
  41.   flname$=SPACE$(13)
  42.   fn$=SPACE$(13)
  43.   flsize$=SPACE$(7)
  44.   fldate$=SPACE$(9)
  45.   ctl_file$="LISTER.CTL"
  46.   search_file$="SEARCH.CTL"
  47.   fdata$="FILES.BBS"
  48.   drv$=CHR$(GEMDOS(25)+65)
  49.   origpath$=drv$+":"+DIR$(0)+"\"
  50.   DIM gnw!(gnum%),keep!(gnum%),mt%(gnum%),totcnt%(gnum%),ntotcnt%(gnum%),totfilesize%(gnum%),totnfilesize%(gnum%),numareas%(number_areas%),top%(tp%-1)
  51.   DIM lzh!(gnum%),arc!(gnum%),zip!(gnum%),nh!(gnum%),newhead!(gnum%),g_max%(gnum%),g_min%(gnum%)
  52.   DIM g_allname$(gnum%),g_newname$(gnum%),g_arcpath$(gnum%),group$(gnum%),g_magic$(gnum%)
  53.   DIM g_allfile$(gnum%),g_newfile$(gnum%),g_allpack$(gnum%),g_newpack$(gnum%),gtp%(gnum%)
  54.   DIM g_header$(gnum%),g_newheader$(gnum%),top$(tp%-1),g_bigfile$(gnum%),g_smallfile$(gnum%),outtp$(gnum%)
  55.   DIM g_top%(gtp%-1,gnum%),g_top$(gtp%-1,gnum%),mv!(gnum%),tt!(gnum%),tc%(gnum%),otp!(gnum%)
  56.   DIM topsize$(tp%-1),topdesc$(tp%-1),g_topsize$(gtp%-1,gnum%),g_topdesc$(gtp%-1,gnum%),toptitle$(gnum%)
  57.   DIM btl$(3),btr$(3),bbl$(3),bbr$(3),bse$(3),be$(3)
  58.   DIM besl$(3),besr$(3),bts$(3),bbs$(3),bcs$(3)
  59.   DIM r$(3),g$(3),b$(3),br$(3),bg$(3),bc$(3)
  60.   '
  61.   ' Ascii screen.
  62.   '
  63.   btl$(0)="+"
  64.   btr$(0)="+"
  65.   bbl$(0)="+"
  66.   bbr$(0)="+"
  67.   bse$(0)="-"
  68.   be$(0)="|"
  69.   besl$(0)="+"
  70.   besr$(0)="+"
  71.   bts$(0)="+"
  72.   bbs$(0)="+"
  73.   bcs$(0)="+"
  74.   g$(0)=""
  75.   r$(0)=""
  76.   b$(0)=""
  77.   br$(0)=""
  78.   bg$(3)=""
  79.   bc$(0)=""
  80.   '
  81.   ' Mono screen.
  82.   '
  83.   btl$(1)="+"
  84.   btr$(1)="+"
  85.   bbl$(1)="+"
  86.   bbr$(1)="+"
  87.   bse$(1)="-"
  88.   be$(1)="|"
  89.   besl$(1)="+"
  90.   besr$(1)="+"
  91.   bts$(1)="+"
  92.   bbs$(1)="+"
  93.   bcs$(1)="+"
  94.   g$(1)=""
  95.   r$(1)=""
  96.   b$(1)=""
  97.   br$(1)="p"
  98.   bg$(1)="p"
  99.   bc$(1)="q"
  100.   '
  101.   ' Colour screen.
  102.   '
  103.   btl$(2)="+"
  104.   btr$(2)="+"
  105.   bbl$(2)="+"
  106.   bbr$(2)="+"
  107.   bse$(2)="-"
  108.   be$(2)="|"
  109.   besl$(2)="+"
  110.   besr$(2)="+"
  111.   bts$(2)="+"
  112.   bbs$(2)="+"
  113.   bcs$(2)="+"
  114.   r$(2)="b1"   ! Red text
  115.   g$(2)="b2"   ! Blue text
  116.   b$(2)="b3"   ! Black text
  117.   br$(2)="c1"  ! Red background
  118.   bg$(2)="c2"  ! Blue background
  119.   bc$(2)="c0"  ! White background
  120.   '
  121.   ' Ansi screen output
  122.   '
  123.   btl$(3)="É"
  124.   btr$(3)="»"
  125.   bbl$(3)="È"
  126.   bbr$(3)="¼"
  127.   bse$(3)="Í"
  128.   be$(3)="º"
  129.   besl$(3)="Ì"
  130.   besr$(3)="¹"
  131.   bts$(3)="Ë"
  132.   bbs$(3)="Ê"
  133.   bcs$(3)="Î"
  134.   r$(3)=""
  135.   g$(3)=""
  136.   b$(3)=""
  137.   br$(3)=""
  138.   bg$(3)=""
  139.   bc$(3)=""
  140.   '
  141.   IF XBIOS(4)=2
  142.     DEFFILL 1,1
  143.     PBOX 0,0,639,62
  144.     th&=32
  145.     th2&=41
  146.   ELSE
  147.     DEFFILL 2,1
  148.     PBOX 0,0,639,31
  149.     th&=18
  150.     th2&=26
  151.   ENDIF
  152.   '
  153.   DEFTEXT 1,0,0,13
  154.   TEXT 144,th&," LiSTer v"+version$+" (c)1993/94 by Robert Darling. "
  155.   DEFTEXT 1,0,0,6
  156.   TEXT 144,th2&," For QuickBBS, ProBBS, and Octopus Systems. "
  157. RETURN
  158. > PROCEDURE parse_ctl_file
  159.   '
  160.   IF EXIST(ctl_file$)
  161.     OPEN "i",#1,ctl_file$
  162.     DIM lster$(1000)
  163.     n&=0
  164.     RECALL #1,lster$(),-1,n%
  165.     CLOSE #1
  166.   ELSE
  167.     display(ctl_file$+" not found. Check it out!")
  168.     PAUSE 100
  169.     END
  170.   ENDIF
  171.   '
  172.   display("Parsing control file...")
  173.   FOR c%=0 TO n%
  174.     lster$(c%)=TRIM$(lster$(c%))
  175.   NEXT c%
  176.   '
  177.   FOR c%=0 TO n%
  178.     IF LEFT$(UPPER$(lster$(c%)),7)="INCDATE"
  179.       fd!=TRUE
  180.       ' Include date
  181.     ENDIF
  182.     '
  183.     IF LEFT$(UPPER$(lster$(c%)),7)="INCSIZE"
  184.       fs!=TRUE
  185.       ' Include size
  186.     ENDIF
  187.     '
  188.     IF LEFT$(UPPER$(lster$(c%)),7)="INCSTAT"
  189.       stat!=TRUE
  190.       ' Include stats
  191.     ENDIF
  192.     '
  193.     IF LEFT$(UPPER$(lster$(c%)),7)="ARCLIST"
  194.       arc!=TRUE
  195.       ' ARC the allfiles list(s)
  196.     ENDIF
  197.     '
  198.     IF LEFT$(UPPER$(lster$(c%)),7)="LZHLIST"
  199.       lzh!=TRUE
  200.       ' LZH the allfiles list(s)
  201.     ENDIF
  202.     '
  203.     IF LEFT$(UPPER$(lster$(c%)),7)="ZIPLIST"
  204.       zip!=TRUE
  205.       ' ZIP the allfiles list(s)
  206.     ENDIF
  207.     '
  208.     IF LEFT$(UPPER$(lster$(c%)),8)="KEEPLIST"
  209.       keep!=TRUE
  210.       ' Don't delete the ascii lists!
  211.     ENDIF
  212.     '
  213.     IF LEFT$(UPPER$(lster$(c%)),15)="USE GROUPS ONLY"
  214.       grp_only!=TRUE
  215.       ' Don't delete the ascii lists!
  216.     ENDIF
  217.     '
  218.     IF LEFT$(UPPER$(lster$(c%)),7)="LOGFILE"
  219.       logit!=TRUE
  220.       IF LEN(lster$(c%))=7
  221.         logpath$="LISTER.LOG"
  222.       ELSE
  223.         a%=INSTR(lster$(c%)," ")
  224.         WHILE MID$(lster$(c%),a%,1)=" "
  225.           INC a%
  226.         WEND
  227.         logpath$=@fullpath$(MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1))+"LISTER.LOG"
  228.         l_drv$=LEFT$(logpath$,1)
  229.       ENDIF
  230.     ENDIF
  231.     '
  232.     IF LEFT$(UPPER$(lster$(c%)),12)="MISSING-INFO"
  233.       mi!=TRUE
  234.     ENDIF
  235.     IF LEFT$(UPPER$(lster$(c%)),7)="FIXDATE"
  236.       fixdate!=TRUE
  237.     ENDIF
  238.     IF LEFT$(UPPER$(lster$(c%)),6)="LATEST"
  239.       a%=INSTR(lster$(c%)," ")
  240.       WHILE MID$(lster$(c%),a%,1)=" "
  241.         INC a%
  242.       WEND
  243.       numdays%=VAL(MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1))
  244.       olddate%=GEMDOS(42)-numdays%
  245.       ' How many days to cover in the newfiles list. Also adds the * to
  246.       ' new files listed in the Allfiles list.
  247.     ENDIF
  248.     IF LEFT$(UPPER$(lster$(c%)),7)="ALLNAME"
  249.       a%=INSTR(lster$(c%)," ")
  250.       WHILE MID$(lster$(c%),a%,1)=" "
  251.         INC a%
  252.       WEND
  253.       allname$=UPPER$(MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1))
  254.       IF INSTR(RIGHT$(allname$,4),".")=0
  255.         allpack$=allname$
  256.         allname$=allname$+".TXT"
  257.       ELSE
  258.         allpack$=UPPER$(LEFT$(allname$,INSTR(allname$,".")-1))
  259.       ENDIF
  260.     ENDIF
  261.     '
  262.     IF LEFT$(UPPER$(lster$(c%)),7)="NEWNAME"
  263.       a%=INSTR(lster$(c%)," ")
  264.       WHILE MID$(lster$(c%),a%,1)=" "
  265.         INC a%
  266.       WEND
  267.       newname$=UPPER$(MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1))
  268.       IF INSTR(RIGHT$(newname$,4),".")=0
  269.         newpack$=newname$
  270.         newname$=newname$+".TXT"
  271.       ELSE
  272.         newpack$=UPPER$(LEFT$(newname$,INSTR(newname$,".")-1))
  273.       ENDIF
  274.       nw!=TRUE
  275.       ' Make a Newfiles list too.
  276.     ENDIF
  277.     '
  278.     IF LEFT$(UPPER$(lster$(c%)),8)="KEEPPATH"
  279.       a%=INSTR(lster$(c%)," ")
  280.       WHILE MID$(lster$(c%),a%,1)=" "
  281.         INC a%
  282.       WEND
  283.       arcpath$=@fullpath$(UPPER$(MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1)))
  284.       allfile$=arcpath$+allname$
  285.       newfile$=arcpath$+newname$
  286.       ' This is where the lists are saved.
  287.     ENDIF
  288.     IF LEFT$(UPPER$(lster$(c%)),6)="HEADER"
  289.       a%=INSTR(lster$(c%)," ")
  290.       WHILE MID$(lster$(c%),a%,1)=" "
  291.         INC a%
  292.       WEND
  293.       header$=MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1)
  294.     ENDIF
  295.     IF LEFT$(UPPER$(lster$(c%)),9)="NEWHEADER"
  296.       a%=INSTR(lster$(c%)," ")
  297.       WHILE MID$(lster$(c%),a%,1)=" "
  298.         INC a%
  299.       WEND
  300.       newheader$=MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1)
  301.       newhead!=TRUE
  302.     ENDIF
  303.     IF LEFT$(UPPER$(lster$(c%)),5)="MAGIC"
  304.       a%=INSTR(lster$(c%)," ")
  305.       WHILE MID$(lster$(c%),a%,1)=" "
  306.         INC a%
  307.       WEND
  308.       magic$=MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1)
  309.     ENDIF
  310.     IF LEFT$(UPPER$(lster$(c%)),6)="FOOTER"
  311.       a%=INSTR(lster$(c%)," ")
  312.       WHILE MID$(lster$(c%),a%,1)=" "
  313.         INC a%
  314.       WEND
  315.       footer$=MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1)
  316.     ENDIF
  317.     IF LEFT$(UPPER$(lster$(c%)),7)="PACKARC"
  318.       a%=RINSTR(lster$(c%)," ")
  319.       packarc$=MID$(lster$(c%),a%+1,LEN(lster$(c%))-a%)
  320.     ENDIF
  321.     IF LEFT$(UPPER$(lster$(c%)),7)="PACKLZH"
  322.       a%=RINSTR(lster$(c%)," ")
  323.       packlzh$=MID$(lster$(c%),a%+1,LEN(lster$(c%))-a%)
  324.     ENDIF
  325.     IF LEFT$(UPPER$(lster$(c%)),7)="PACKZIP"
  326.       a%=RINSTR(lster$(c%)," ")
  327.       packzip$=MID$(lster$(c%),a%+1,LEN(lster$(c%))-a%)
  328.     ENDIF
  329.     '
  330.     IF LEFT$(UPPER$(lster$(c%)),5)="GROUP"
  331.       @group_data
  332.     ENDIF
  333.     '
  334.     IF LEFT$(UPPER$(lster$(c%)),6)="PROBBS"
  335.       probbs!=TRUE
  336.       fdata$="FILES.DAT"
  337.     ENDIF
  338.     '
  339.     IF LEFT$(UPPER$(lster$(c%)),7)="OCTOPUS"
  340.       octopus!=TRUE
  341.     ENDIF
  342.     '
  343.     IF LEFT$(UPPER$(lster$(c%)),5)="AREAS"
  344.       a%=INSTR(lster$(c%)," ")
  345.       WHILE MID$(lster$(c%),a%,1)=" "
  346.         INC a%
  347.       WEND
  348.       number_areas%=VAL(MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1))
  349.     ENDIF
  350.     '
  351.     IF LEFT$(UPPER$(lster$(c%)),6)="TOPTEN"
  352.       topten!=TRUE
  353.       a%=RINSTR(lster$(c%)," ")
  354.       bracket1$=MID$(lster$(c%),a%+1,1)
  355.       bracket2$=MID$(lster$(c%),a%+2,1)
  356.     ENDIF
  357.     '
  358.     IF LEFT$(UPPER$(lster$(c%)),8)="PROCOUNT"
  359.       a%=RINSTR(lster$(c%)," ")
  360.       bracket1$=MID$(lster$(c%),a%+1,1)
  361.       bracket2$=MID$(lster$(c%),a%+2,1)
  362.     ENDIF
  363.     '
  364.     IF LEFT$(UPPER$(lster$(c%)),8)="TOPTITLE"
  365.       a%=INSTR(lster$(c%)," ")
  366.       WHILE MID$(lster$(c%),a%,1)=" "
  367.         INC a%
  368.       WEND
  369.       toptitle$=TRIM$(LEFT$(MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1),74))
  370.     ENDIF
  371.     '
  372.     IF LEFT$(UPPER$(lster$(c%)),7)="LISTTOP"
  373.       a%=INSTR(lster$(c%),"$")
  374.       tp%=VAL(MID$(lster$(c%),a%+1,LEN(lster$(c%))-a%))
  375.       '
  376.       IF tp%=0
  377.         tp%=10
  378.       ENDIF
  379.       '
  380.       IF tp%>50
  381.         tp%=50
  382.       ENDIF
  383.       '
  384.       @redimension
  385.     ENDIF
  386.     '
  387.     IF LEFT$(UPPER$(lster$(c%)),12)="WRITE TOPTEN"
  388.       a%=RINSTR(lster$(c%)," ")
  389.       WHILE MID$(lster$(c%),a%,1)=" "
  390.         INC a%
  391.       WEND
  392.       outtp$=@fullpath$(MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1))
  393.       outtp$=outtp$+"TOP_"+STR$(tp%)
  394.       IF topten!
  395.         otp!=TRUE
  396.       ENDIF
  397.     ENDIF
  398.     '
  399.     IF LEFT$(UPPER$(lster$(c%)),8)="FOURTOPS"
  400.       fourtops!=TRUE
  401.     ENDIF
  402.     '
  403.     IF LEFT$(UPPER$(lster$(c%)),4)="OMIT"
  404.       @omit_files
  405.     ENDIF
  406.     '
  407.     IF LEFT$(UPPER$(lster$(c%)),7)="SHOWMEM"
  408.       smem!=TRUE
  409.     ENDIF
  410.     '
  411.     IF LEFT$(UPPER$(lster$(c%)),5)="DEBUG"
  412.       debug!=TRUE
  413.       dblog$="DEBUG.LOG"
  414.       display("Debug mode activated.")
  415.       display("")
  416.       IF EXIST(dblog$)=0
  417.         MODE 3
  418.         OPEN "o",#2,dblog$
  419.         PRINT #2,"--------------------------------------------------"
  420.         PRINT #2,"LiSTer "+version$+" Debug Log - Created on "+MID$(DATE$,4,3)+LEFT$(DATE$,3)+RIGHT$(DATE$,2)+" at "+TIME$
  421.         PRINT #2,"--------------------------------------------------"
  422.         PRINT #2
  423.         CLOSE #2
  424.       ENDIF
  425.     ENDIF
  426.   NEXT c%
  427. RETURN
  428. > PROCEDURE redimension
  429.   ERASE top%(),top$(),topsize$(),topdesc$()
  430.   DIM top%(tp%-1),top$(tp%-1),topsize$(tp%-1),topdesc$(tp%-1)
  431. RETURN
  432. '
  433. ' Text files to be included in lists.
  434. '
  435. > PROCEDURE add_header
  436.   IF grp_only!
  437.     GOTO group_headers
  438.   ENDIF
  439.   '
  440.   IF EXIST(header$)
  441.     DIM head$(300)
  442.     OPEN "I",#1,header$
  443.     RECALL #1,head$(),-1,header%
  444.     CLOSE #1
  445.     '
  446.     OPEN "O",#1,allname$
  447.     STORE #1,head$(),header%
  448.     CLOSE #1
  449.   ENDIF
  450.   '
  451.   IF newhead! AND nw!
  452.     IF EXIST(newheader$)
  453.       DIM newhead$(300)
  454.       OPEN "i",#1,newheader$
  455.       RECALL #1,newhead$(),-1,header%
  456.       CLOSE #1
  457.       nh!=TRUE          !Alternative header file for newfiles list.
  458.     ENDIF
  459.   ENDIF
  460.   IF nw!
  461.     OPEN "O",#1,newname$
  462.     IF nh!
  463.       STORE #1,newhead$(),header%
  464.     ELSE
  465.       STORE #1,head$(),header%
  466.     ENDIF
  467.     CLOSE #1
  468.   ENDIF
  469.   '
  470.   ERASE head$(),newhead$()
  471.   ~FRE(0)
  472.   '
  473. group_headers:
  474.   '
  475.   ' Write headers for other lists if needed.
  476.   '
  477.   IF grp_activate!
  478.     @group_headers
  479.   ENDIF
  480. RETURN
  481. > PROCEDURE add_magic
  482.   IF grp_only!
  483.     GOTO group_magics
  484.   ENDIF
  485.   '
  486.   IF EXIST(magic$)
  487.     DIM mag$(300)
  488.     OPEN "I",#1,magic$
  489.     RECALL #1,mag$(),-1,mag%
  490.     CLOSE #1
  491.     IF EXIST(allname$)
  492.       OPEN "a",#1,allname$
  493.       STORE #1,mag$(),mag%
  494.       CLOSE #1
  495.     ELSE
  496.       OPEN "o",#1,allname$
  497.       STORE #1,mag$(),mag%
  498.       CLOSE #1
  499.     ENDIF
  500.     '
  501.     IF nw!
  502.       IF EXIST(newname$)
  503.         OPEN "a",#1,newname$
  504.         STORE #1,mag$(),mag%
  505.         CLOSE #1
  506.       ELSE
  507.         OPEN "a",#1,newname$
  508.         STORE #1,mag$(),mag%
  509.         CLOSE #1
  510.       ENDIF
  511.     ENDIF
  512.   ENDIF
  513.   '
  514.   ERASE mag$()
  515.   ~FRE(0)
  516.   '
  517. group_magics:
  518.   '
  519.   ' Write group magics if required.
  520.   '
  521.   IF grp_activate!
  522.     @group_magics
  523.   ENDIF
  524. RETURN
  525. > PROCEDURE add_footer
  526.   IF EXIST(footer$) AND ft!=FALSE
  527.     DIM foot$(300)
  528.     OPEN "I",#2,footer$
  529.     RECALL #2,foot$(),-1,foot%
  530.     CLOSE #2
  531.     ft!=TRUE
  532.   ENDIF
  533.   '
  534.   IF all!
  535.     PRINT #1,""
  536.     STORE #1,foot$(),foot%
  537.   ENDIF
  538.   '
  539.   IF newfoot!
  540.     PRINT #1,""
  541.     STORE #1,foot$(),foot%
  542.   ENDIF
  543. RETURN
  544. '
  545. ' Creation of actual filelists starts here!
  546. '
  547. > PROCEDURE paths_to_search
  548.   ' Provides a list of the paths to be searched for files.
  549.   @show_mem(STR$(FRE()))
  550.   '
  551.   IF EXIST(search_file$)
  552.     OPEN "i",#1,search_file$
  553.     DIM lst$(number_areas%)
  554.     x%=0
  555.     RECALL #1,lst$(),-1,x%
  556.     CLOSE #1
  557.   ELSE
  558.     display("SEARCH.CTL not found. Check it out!")
  559.     PAUSE 100
  560.     END
  561.   ENDIF
  562.   '
  563.   ' lst$(x%) now contains the list of areas to search.
  564.   '
  565.   n&=0
  566.   REPEAT
  567.     an&=n&+1
  568.     title$=""
  569.     group$=""
  570.     '
  571.     ' Get path to files...
  572.     '
  573.     spc&=INSTR(lst$(n&)," ")  ! Look for first space.
  574.     IF spc&=0 AND LEN(lst$(n&))>0
  575.       spc&=LEN(lst$(n&))+1
  576.     ENDIF
  577.     path$=LEFT$(lst$(n&),spc&-1)
  578.     backslash(path$)
  579.     '
  580.     IF octopus!
  581.       '
  582.       ' Get area title (for Octopus lists)
  583.       '
  584.       st&=INSTR(lst$(n&),"[")
  585.       end&=INSTR(lst$(n&),"]")
  586.       IF st&>0 AND end&>0
  587.         title$=MID$(lst$(n&),st&+1,end&-st&-1)
  588.       ENDIF
  589.     ENDIF
  590.     '
  591.     IF probbs!
  592.       '
  593.       ' Get area title (for ProBBS lists)
  594.       '
  595.       st&=INSTR(lst$(n&),"[")
  596.       end&=INSTR(lst$(n&),"]")
  597.       IF st&>0 AND end&>0
  598.         title$=MID$(lst$(n&),st&+1,end&-st&-1)
  599.       ENDIF
  600.       '
  601.       ' Get path to FILES.DAT if different from file area (for ProBBS)
  602.       '
  603.       st2&=INSTR(lst$(n&),"{")
  604.       end2&=INSTR(lst$(n&),"}")
  605.       IF st2&>0 AND end2&>0
  606.         dat_path$=MID$(lst$(n&),st2&+1,end2&-st2&-1)
  607.         backslash(dat_path$)
  608.         dp!=TRUE
  609.       ELSE
  610.         dat_path$=path$
  611.         dp!=FALSE
  612.       ENDIF
  613.       '
  614.     ENDIF
  615.     '
  616.     ' Get Group info if available.
  617.     '
  618.     grp_st&=INSTR(lst$(n&),"%")
  619.     IF grp_st&>0
  620.       grp_end&=INSTR(lst$(n&)," ",grp_st&)
  621.       IF grp_end&=0
  622.         grp_end&=LEN(lst$(n&))+1
  623.       ENDIF
  624.       group$=MID$(lst$(n&),grp_st&+1,grp_end&-grp_st&)
  625.     ENDIF
  626.     '
  627.     IF grp_only! AND group$=""
  628.       INC an&
  629.       GOTO miss_area
  630.     ENDIF
  631.     '
  632.     IF spc&>0
  633.       IF EXIST(path$+fdata$) OR EXIST(dat_path$+fdata$)
  634.         @show_mem(STR$(FRE()))
  635.         catalogue(path$+"*.*")
  636.         flbbs!=FALSE
  637.         ERASE fbbs$()
  638.         ~FRE(0)
  639.         @show_mem(STR$(FRE()))
  640.         IF i%=0 OR cnt%=0
  641.           INC an&
  642.           GOTO miss_area
  643.         ELSE
  644.           INC an&
  645.           output_file_lists
  646.           @show_mem(STR$(FRE()))
  647.         ENDIF
  648.       ENDIF
  649.     ENDIF
  650.   miss_area:
  651.     INC n&
  652.   UNTIL LEN(lst$(n&))=0
  653.   '
  654.   ' Clean up memory a bit, make more available.
  655.   '
  656.   @show_mem(STR$(FRE()))
  657.   ERASE info$(),info_new$(),fname$(),fsize$(),fdate%(),lst$(),title$()
  658.   ~FRE(0)
  659.   @show_mem(STR$(FRE()))
  660. RETURN
  661. > PROCEDURE catalogue(search$)
  662.   display("Searching: "+search$)
  663.   IF debug!
  664.     blank!=TRUE
  665.     debug("Searching "+search$)
  666.     blank!=FALSE
  667.   ENDIF
  668.   cnt%=0
  669.   cnt2%=0
  670.   mf%=0
  671.   md%=0
  672.   areafsize%=0
  673.   nareafsize%=0
  674.   logcnt&=0
  675.   ERASE info$(),info_new$(),fname$(),fsize$(),fdate%()
  676.   DIM info$(max_files%),info_new$(max_files%),fname$(max_files%),fsize$(max_files%),fdate%(max_files%)
  677.   bufadr%=FGETDTA()
  678.   search%=FSFIRST(search$,&X100001)
  679.   i%=0
  680.   DO UNTIL search%
  681.     fname$(i%)=CHAR{bufadr%+30}
  682.     EXIT IF fname$(i%)=""
  683.     fsize$(i%)=STR$({bufadr%+26})
  684.     fdate%(i%)=CARD{bufadr%+24}
  685.     INC i%
  686.     search%=FSNEXT()
  687.   LOOP
  688.   IF i%=0
  689.     GOTO go_back
  690.   ENDIF
  691.   DEC i%
  692.   FOR j%=0 TO i%
  693.     IF debug!
  694.       debug("Filename: "+fname$(j%))
  695.     ENDIF
  696.     IF fname$(j%)<>"FILES.BBS" AND fname$(j%)<>"FILES.BAK" AND fname$(j%)<>"FILES.DAT" AND fname$(j%)<>"FILES.HAS" AND fname$(j%)<>"FILES.BAC"
  697.       '
  698.       IF fdate%(j%)>=olddate% AND fdate%<=today%
  699.         fnew!=TRUE
  700.       ENDIF
  701.       '
  702.       mx%=VAL(fsize$(j%))
  703.       IF mx%>max%
  704.         SWAP max%,mx%
  705.         bigfile$=fname$(j%)
  706.         IF grp_activate! AND group$<>""
  707.           @g_bigfile(bigfile$,max%)
  708.         ENDIF
  709.       ENDIF
  710.       '
  711.       IF mx%>0 AND mx%<min%
  712.         SWAP min%,mx%
  713.         smallfile$=fname$(j%)
  714.         IF grp_activate! AND group$<>""
  715.           @g_smallfile(smallfile$,min%)
  716.         ENDIF
  717.       ENDIF
  718.       '
  719.       make_date(fdate%(j%))
  720.       make_line(fname$(j%),fsize$(j%),fdate$)
  721.       INC cnt%
  722.     ENDIF
  723.   NEXT j%
  724. go_back:
  725. RETURN
  726. > PROCEDURE make_line(fname$,fsize$,fdate$)
  727.   LSET flname$=fname$
  728.   RSET flsize$=fsize$
  729.   LSET fldate$=fdate$
  730.   IF fnew!
  731.     MID$(fldate$,9,1)="*"
  732.   ENDIF
  733.   '
  734.   IF fs! AND fd!
  735.     fl&=46
  736.     areafsize%=areafsize%+VAL(fsize$)
  737.     fldesc(fname$)
  738.     info$(cnt%)=flname$+flsize$+" "+fldate$+" "+fldesc$
  739.     IF nw! AND fnew!
  740.       nareafsize%=nareafsize%+VAL(fsize$)
  741.       info_new$(cnt2%)=info$(cnt%)
  742.       MID$(info_new$(cnt2%),30,1)=" "
  743.       INC cnt2%
  744.     ENDIF
  745.     '
  746.   ELSE IF fs!
  747.     fl&=56
  748.     areafsize%=areafsize%+VAL(fsize$)
  749.     fldesc(fname$)
  750.     info$(cnt%)=flname$+flsize$+" "+fldesc$
  751.     IF nw! AND fnew!
  752.       nareafsize%=nareafsize%+VAL(fsize$)
  753.       info_new$(cnt2%)=info$(cnt%)
  754.       INC cnt2%
  755.     ENDIF
  756.     '
  757.   ELSE IF fd!
  758.     fl&=53
  759.     areafsize%=areafsize%+VAL(fsize$)
  760.     fldesc(fname$)
  761.     info$(cnt%)=flname$+" "+fldate$+" "+fldesc$
  762.     IF nw! AND fnew!
  763.       nareafsize%=nareafsize%+VAL(fsize$)
  764.       info_new$(cnt2%)=info$(cnt%)
  765.       MID$(info_new$(cnt2%),24,1)=" "
  766.       INC cnt2%
  767.     ENDIF
  768.     '
  769.   ELSE
  770.     fl&=64
  771.     areafsize%=areafsize%+VAL(fsize$)
  772.     fldesc(fname$)
  773.     info$(cnt%)=flname$+fldesc$
  774.     IF nw! AND fnew!
  775.       nareafsize%=nareafsize%+VAL(fsize$)
  776.       info_new$(cnt2%)=info$(cnt%)
  777.       INC cnt2%
  778.     ENDIF
  779.   ENDIF
  780.   fnew!=FALSE
  781. RETURN
  782. > PROCEDURE fldesc(fname$)
  783.   '
  784.   ' If info for area not in memory.... load it!
  785.   '
  786.   IF flbbs!=FALSE
  787.     DIM fbbs$(max_files%)
  788.     IF probbs!
  789.       ERASE dl%()
  790.       DIM dl%(max_files%)
  791.       @probbs_title_and_data
  792.     ELSE IF octopus!
  793.       @octopus_title_and_data
  794.     ELSE
  795.       @qbbs_title_and_data
  796.     ENDIF
  797.     flbbs!=TRUE
  798.   ENDIF
  799.   '
  800.   find&=0
  801.   f!=FALSE
  802.   fldesc$=""
  803.   '
  804.   DO
  805.     '
  806.     IF LEN(TRIM$(fbbs$(find&)))<13
  807.       IF INSTR(LEFT$(fbbs$(find&),LEN(fname$)),fname$)>0
  808.         INC md%
  809.         IF debug!
  810.           debug("File description missing for "+fname$)
  811.         ENDIF
  812.         fldesc$="*** File Description Missing ***"
  813.         @logit(path$+fname$+" has no description in "+fdata$)
  814.         f!=TRUE
  815.       ENDIF
  816.       '
  817.     ELSE IF INSTR(LEFT$(fbbs$(find&),LEN(fname$)),fname$)>0
  818.       a|=INSTR(fbbs$(find&)," ")
  819.       WHILE MID$(fbbs$(find&),a|,1)=" "
  820.         INC a|
  821.       WEND
  822.       fldesc$=RIGHT$(fbbs$(find&),LEN(fbbs$(find&))-a|+1)
  823.       '
  824.       IF topten! AND INSTR(omitfile$,fname$(j%))=0
  825.         IF probbs!
  826.           fnum%=dl%(find&)
  827.           @pro_topten(fname$,fnum%)
  828.         ELSE
  829.           @topten(LEFT$(fldesc$,10),fname$)
  830.         ENDIF
  831.         IF group$<>"" AND fnum%>0 AND grp_activate!
  832.           @group_topten
  833.         ENDIF
  834.       ENDIF
  835.       '
  836.       IF probbs!
  837.         IF dl%(find&)>0
  838.           fldesc$=bracket1$+STR$(dl%(find&))+bracket2$+" "+fldesc$
  839.         ENDIF
  840.       ENDIF
  841.       '
  842.       format_desc(fldesc$)
  843.       f!=TRUE
  844.       '
  845.     ENDIF
  846.     '
  847.     INC find&
  848.   LOOP UNTIL find&=x% OR f!
  849.   '
  850.   IF fldesc$=""
  851.     IF debug!
  852.       debug("No entry found for "+fname$)
  853.     ENDIF
  854.     fldesc$="*** Description not available ***"
  855.     INC mf%
  856.     @logit(path$+fdata$+" contains no entry for "+fname$)
  857.   ENDIF
  858.   '
  859. RETURN
  860. > PROCEDURE qbbs_title_and_data
  861.   OPEN "i",#1,path$+fdata$
  862.   x%=0
  863.   RECALL #1,fbbs$(),-1,x%
  864.   CLOSE #1
  865.   '
  866.   ERASE title$()
  867.   ~FRE(0)
  868.   DIM title$(20)
  869.   tcnt%=0
  870.   '
  871.   WHILE INSTR(LEFT$(fbbs$(tcnt%),9),".")=0 AND fbbs$(tcnt%)<>""
  872.     title$(tcnt%)=fbbs$(tcnt%)
  873.     INC tcnt%
  874.   WEND
  875.   '
  876.   IF tcnt%=0
  877.     title$="File Area Number "+STR$(an&)
  878.     l|=LEN(title$)
  879.     title$(0)=SPACE$((80-l|)/2-4)+STRING$(l|+8,"~")
  880.     title$(1)=SPACE$((80-l|)/2-4)+"**  "+title$+"  **"
  881.     title$(2)=title$(0)
  882.     title$(3)=""
  883.     tcnt%=3
  884.   ENDIF
  885.   IF fbbs$(tcnt%)<>""
  886.     DEC tcnt%
  887.   ENDIF
  888. RETURN
  889. > PROCEDURE probbs_title_and_data
  890.   '
  891.   IF dp!
  892.     OPEN "r",#1,dat_path$+fdata$,314
  893.   ELSE
  894.     OPEN "r",#1,path$+fdata$,314
  895.   ENDIF
  896.   '
  897.   nr%=LOF(#1)/314
  898.   FIELD #1,13 AS fnm$,244 AS fd$,55 AS void$,2 AT(*dl&)
  899.   FOR x%=1 TO nr%
  900.     GET #1,x%
  901.     LSET fn$=CHAR{V:fnm$}
  902.     fbbs$(x%-1)=TRIM$(CHAR{V:fd$})
  903.     IF INSTR(fbbs$(x%-1),bracket1$)=1 AND INSTR(fbbs$(x%-1),bracket2$)<5
  904.       x2%=INSTR(fbbs$(x%-1),bracket2$)
  905.       fbbs$(x%-1)=MID$(fbbs$(x%-1),x2%+2,LEN(fbbs$(x%-1))-(x2%+2))
  906.     ENDIF
  907.     fbbs$(x%-1)=fn$+fbbs$(x%-1)
  908.     dl%(x%-1)=dl&
  909.   NEXT x%
  910.   CLOSE #1
  911.   '
  912.   ERASE title$()
  913.   ~FRE(0)
  914.   DIM title$(20)
  915.   IF title$<>""
  916.     l|=LEN(title$)
  917.     title$(0)=SPACE$((80-l|)/2-4)+STRING$(l|+8,"~")
  918.     title$(1)=SPACE$((80-l|)/2-4)+"**  "+title$+"  **"
  919.     title$(2)=title$(0)
  920.     title$(3)=""
  921.     tcnt%=3
  922.   ELSE
  923.     title$="File Area Number "+STR$(an&)
  924.     l|=LEN(title$)
  925.     title$(0)=SPACE$((80-l|)/2-4)+STRING$(l|+8,"~")
  926.     title$(1)=SPACE$((80-l|)/2-4)+"**  "+title$+"  **"
  927.     title$(2)=title$(0)
  928.     title$(3)=""
  929.     tcnt%=3
  930.   ENDIF
  931. RETURN
  932. > PROCEDURE octopus_title_and_data
  933.   OPEN "i",#1,path$+fdata$
  934.   x%=0
  935.   RECALL #1,fbbs$(),-1,x%
  936.   CLOSE #1
  937.   '
  938.   ERASE title$()
  939.   ~FRE(0)
  940.   DIM title$(20)
  941.   '
  942.   IF title$<>""
  943.     l|=LEN(title$)
  944.     title$(0)=SPACE$((80-l|)/2-4)+STRING$(l|+8,"~")
  945.     title$(1)=SPACE$((80-l|)/2-4)+"**  "+title$+"  **"
  946.     title$(2)=title$(0)
  947.     title$(3)=""
  948.     tcnt%=3
  949.   ELSE
  950.     title$="File Area Number "+STR$(an&)
  951.     l|=LEN(title$)
  952.     title$(0)=SPACE$((80-l|)/2-4)+STRING$(l|+8,"~")
  953.     title$(1)=SPACE$((80-l|)/2-4)+"**  "+title$+"  **"
  954.     title$(2)=title$(0)
  955.     title$(3)=""
  956.     tcnt%=3
  957.   ENDIF
  958. RETURN
  959. > PROCEDURE format_desc(VAR fldesc$)
  960.   LOCAL a$
  961.   IF debug!
  962.     debug("File description found for "+fname$)
  963.   ENDIF
  964.   '
  965.   WHILE LEN(fldesc$)>fl&
  966.     blank%=RINSTR(fldesc$," ",fl&+1)
  967.     IF blank%<fl&/3
  968.       blank%=fl&+1
  969.       DO
  970.         DEC blank%
  971.         a$=MID$(fldesc$,blank%,1)
  972.         EXIT IF ASC(a$)<48 OR ASC(a$)>57 AND ASC(a$)<65 OR ASC(a$)>122
  973.       LOOP
  974.     ENDIF
  975.     ' tmpdesc$=tmpdesc$+LEFT$(fldesc$,fl&)+CHR$(13)+CHR$(10)+SPACE$(31-(fl&-46))
  976.     ' fldesc$=RIGHT$(fldesc$,LEN(fldesc$)-fl&)
  977.     ' ELSE
  978.     tmpdesc$=tmpdesc$+LEFT$(fldesc$,blank%)+CHR$(13)+CHR$(10)+SPACE$(31-(fl&-46))
  979.     fldesc$=RIGHT$(fldesc$,LEN(fldesc$)-blank%)
  980.     ' ENDIF
  981.   WEND
  982.   fldesc$=tmpdesc$+fldesc$
  983.   tmpdesc$=""
  984. RETURN
  985. > PROCEDURE output_file_lists
  986.   '
  987.   ' Sort lists before writing.
  988.   '
  989.   IF cnt%>0
  990.     QSORT info$(),cnt%
  991.     IF cnt2%>0
  992.       QSORT info_new$(),cnt2%
  993.     ENDIF
  994.   ENDIF
  995.   '
  996.   IF grp_only!
  997.     GOTO group_output
  998.   ENDIF
  999.   '
  1000.   IF rn!
  1001.     make_date(GEMDOS(42))
  1002.     IF EXIST(allname$)
  1003.       OPEN "a",#1,allname$
  1004.     ELSE
  1005.       OPEN "o",#1,allname$
  1006.     ENDIF
  1007.     PRINT #1,"List created : ";fdate$
  1008.     PRINT #1,"Files marked with a '*' are new in the last ";STR$(numdays%);" days."
  1009.     PRINT #1,""
  1010.     CLOSE #1
  1011.     rn!=FALSE
  1012.   ENDIF
  1013.   '
  1014.   IF EXIST(allname$)
  1015.     OPEN "a",#1,allname$
  1016.     update_list1
  1017.     CLOSE #1
  1018.   ENDIF
  1019.   '
  1020.   IF cnt2%>0
  1021.     IF EXIST(newname$)
  1022.       OPEN "a",#1,newname$
  1023.       update_list2
  1024.       CLOSE #1
  1025.     ENDIF
  1026.   ENDIF
  1027.   '
  1028.   INC numareas&
  1029.   mt%=mt%+md%+mf%
  1030.   totcnt%=totcnt%+cnt%
  1031.   ntotcnt%=ntotcnt%+cnt2%
  1032.   totfilesize%=totfilesize%+areafsize%
  1033.   totnfilesize%=totnfilesize%+nareafsize%
  1034.   '
  1035. group_output:
  1036.   IF grp_activate! AND group$<>""
  1037.     @group_output_file_lists
  1038.   ENDIF
  1039. RETURN
  1040. > PROCEDURE logo
  1041.   '
  1042.   IF totfilesize%>=1024
  1043.     asz%=INT(totfilesize%/1024)
  1044.     asz$=" Kbytes."
  1045.   ELSE
  1046.     asz%=INT(totfilesize%)
  1047.     asz$=" bytes"
  1048.   ENDIF
  1049.   '
  1050.   IF totcnt%>0
  1051.     avsz%=INT(totfilesize%/totcnt%)
  1052.     IF avsz%>=1024
  1053.       avsz%=avsz%/1024
  1054.       avsz$=" Kbytes."
  1055.     ELSE
  1056.       avsz$=" bytes."
  1057.     ENDIF
  1058.   ENDIF
  1059.   '
  1060.   IF totnfilesize%>=1024
  1061.     nsz%=INT(totnfilesize%/1024)
  1062.     nsz$=" Kbytes."
  1063.   ELSE
  1064.     nsz%=INT(totnfilesize%)
  1065.     nsz$=" bytes"
  1066.   ENDIF
  1067.   '
  1068.   IF ntotcnt%>0
  1069.     navsz%=INT(totnfilesize%/ntotcnt%)
  1070.     IF navsz%>=1024
  1071.       navsz%=navsz%/1024
  1072.       navsz$=" Kbytes."
  1073.     ELSE
  1074.       navsz$=" bytes."
  1075.     ENDIF
  1076.   ENDIF
  1077.   '
  1078.   fttop$=SPACE$(13)
  1079.   ftsize$=SPACE$(7)
  1080.   ftdesc$=SPACE$(36)
  1081.   bord$=" "+STRING$(78,"=")
  1082.   logo$="List generated by BBS LiSTer v"+version$+" (c)1993/94 by Robert Darling."
  1083.   logo$=SPACE$((80-LEN(logo$))/2)+logo$
  1084.   large$="Largest file is "+bigfile$+" at "+STR$(max%)+" bytes."
  1085.   small$="Smallest file is "+smallfile$+" at "+STR$(min%)+" bytes."
  1086.   pad$="Total file size      : "+STR$(asz%)+asz$
  1087.   pad%=(80-LEN(pad$))/2
  1088.   large%=(80-LEN(large$))/2
  1089.   large$=SPACE$(large%)+large$
  1090.   small$=SPACE$(large%)+small$
  1091.   '
  1092.   IF grp_only!
  1093.     GOTO group_finish
  1094.   ENDIF
  1095.   '
  1096.   IF EXIST(allname$)
  1097.     all!=TRUE
  1098.     OPEN "a",#1,allname$
  1099.     IF stat!
  1100.       PRINT #1,bord$
  1101.       PRINT #1
  1102.       PRINT #1,SPACE$(pad%);"Total files available: ";totcnt%
  1103.       PRINT #1,SPACE$(pad%);"Total file size      : ";asz%;asz$
  1104.       PRINT #1,SPACE$(pad%);"Number of areas      : ";numareas&
  1105.       IF avsz%>0
  1106.         PRINT #1,SPACE$(pad%);"Average file length  : ";avsz%;avsz$
  1107.       ENDIF
  1108.       IF mi!
  1109.         PRINT #1,SPACE$(pad%);"Descriptions missing : ";mt%
  1110.       ENDIF
  1111.       PRINT #1
  1112.       PRINT #1,large$
  1113.       PRINT #1,small$
  1114.       IF topten!
  1115.         PRINT #1
  1116.         PRINT #1,SPACE$(16);"Top ";STR$(tp%);" most popular files on this system are..."
  1117.         PRINT #1
  1118.         PRINT #1,SPACE$(20);"Position  Filename       Number of d/l's"
  1119.         PRINT #1
  1120.         FOR i%=0 TO tc%
  1121.           EXIT IF top$(i%)=""
  1122.           LSET fttop$=top$(i%)
  1123.           PRINT #1,SPACE$(19);STR$(i%+1,6);".    ";fttop$;"     ";STR$(top%(i%),6)
  1124.         NEXT i%
  1125.         PRINT #1
  1126.       ENDIF
  1127.       PRINT #1,bord$
  1128.     ENDIF
  1129.     add_footer
  1130.     IF ft!
  1131.       PRINT #1
  1132.     ENDIF
  1133.     PRINT #1,logo$
  1134.     CLOSE #1
  1135.     all!=FALSE
  1136.   ENDIF
  1137.   '
  1138.   IF otp!
  1139.     @clear
  1140.     IF fourtops!
  1141.       tx%=3
  1142.     ELSE
  1143.       tx%=0
  1144.     ENDIF
  1145.     '
  1146.     FOR b%=0 TO tx%
  1147.       '
  1148.       IF b%=0           ! Straight ASCII output
  1149.         ext$=".ASC"
  1150.       ELSE IF b%=1      ! Mono output
  1151.         ext$=".VTM"
  1152.       ELSE IF b%=2      ! Colour output
  1153.         ext$=".VTC"
  1154.       ELSE
  1155.         ext$=".ANS"     ! ANSI output
  1156.       ENDIF
  1157.       hdl$=" "+g$(b%)+be$(b%)+b$(b%)+br$(b%)+" No. "+bc$(b%)+g$(b%)+be$(b%)+b$(b%)+"  "+br$(b%)+" Filename "+bc$(b%)+"  "+g$(b%)+be$(b%)+b$(b%)+" "+br$(b%)+" Size "+bc$(b%)+"  "+g$(b%)+be$(b%)+b$(b%)+br$(b%)+" DL'd "+bc$(b%)+g$(b%)+be$(b%)+b$(b%)
  1158.       hdl$=hdl$+" "+br$(b%)+" Description "+bc$(b%)+SPACE$(24)+g$(b%)+be$(b%)+b$(b%)
  1159.       tsepl$=" "+g$(b%)+besl$(b%)+STRING$(5,bse$(b%))+bts$(b%)+STRING$(14,bse$(b%))+bts$(b%)+STRING$(9,bse$(b%))+bts$(b%)+STRING$(6,bse$(b%))+bts$(b%)+STRING$(38,bse$(b%))+besr$(b%)+b$(b%)
  1160.       sepl$=" "+g$(b%)+besl$(b%)+STRING$(5,bse$(b%))+bcs$(b%)+STRING$(14,bse$(b%))+bcs$(b%)+STRING$(9,bse$(b%))+bcs$(b%)+STRING$(6,bse$(b%))+bcs$(b%)+STRING$(38,bse$(b%))+besr$(b%)+b$(b%)
  1161.       '
  1162.       IF toptitle$=""
  1163.         topadd$=SPACE$(11)+"The Top "+STR$(tp%,2)+" Chart - created on "+DATE$+" at "+TIME$+SPACE$(11)
  1164.       ELSE
  1165.         IF LEN(toptitle$) MOD 2=1
  1166.           padit|=1
  1167.         ELSE
  1168.           padit|=0
  1169.         ENDIF
  1170.         spc%=(74-LEN(toptitle$))/2
  1171.         spc2%=spc%+padit|
  1172.         topadd$=SPACE$(spc%)+toptitle$+SPACE$(spc2%)
  1173.       ENDIF
  1174.       '
  1175.       topper$=" "+g$(b%)+be$(b%)+b$(b%)+" "+br$(b%)+topadd$+bc$(b%)+" "+g$(b%)+be$(b%)+b$(b%)
  1176.       display("Writing "+outtp$+ext$)
  1177.       OPEN "o",#1,outtp$+ext$
  1178.       PRINT #1,"  ";g$(b%);btl$(b%);STRING$(76,bse$(b%));btr$(b%);b$(b%)
  1179.       PRINT #1,topper$
  1180.       PRINT #1,tsepl$
  1181.       PRINT #1,hdl$
  1182.       PRINT #1,sepl$
  1183.       FOR i%=0 TO tc%
  1184.         EXIT IF top$(i%)=""
  1185.         LSET fttop$=top$(i%)
  1186.         RSET ftsize$=topsize$(i%)
  1187.         LSET ftdesc$=topdesc$(i%)
  1188.         PRINT #1," ";g$(b%);be$(b%);r$(b%);STR$(i%+1,3);". ";g$(b%);be$(b%);b$(b%);" ";fttop$;g$(b%);be$(b%);" ";r$(b%);ftsize$;b$(b%);" ";g$(b%);be$(b%);" ";r$(b%);STR$(top%(i%),4);g$(b%);" ";be$(b%);b$(b%);" ";ftdesc$;" ";g$(b%);be$(b%);b$(b%)
  1189.       NEXT i%
  1190.       PRINT #1," ";g$(b%);besl$(b%);STRING$(5,bse$(b%));bbs$(b%);STRING$(14,bse$(b%));bbs$(b%);STRING$(9,bse$(b%));bbs$(b%);STRING$(6,bse$(b%));bbs$(b%);STRING$(38,bse$(b%));besr$(b%);b$(b%)
  1191.       PRINT #1," ";g$(b%);be$(b%);b$(b%);SPACE$(6);"Top ";STR$(tp%,2);" produced by ";br$(b%);" LiSTer V";version$;" ";bc$(b%);" (c)1993/94 by Robert Darling.";SPACE$(7);g$(b%);be$(b%);b$(b%)
  1192.       PRINT #1," ";g$(b%);bbl$(b%);STRING$(76,bse$(b%));bbr$(b%);b$(b%)
  1193.       CLOSE #1
  1194.     NEXT b%
  1195.   ENDIF
  1196.   '
  1197.   IF EXIST(newname$) AND nw!
  1198.     newfoot!=TRUE
  1199.     OPEN "a",#1,newname$
  1200.     IF stat!
  1201.       PRINT #1,bord$
  1202.       PRINT #1
  1203.       PRINT #1,SPACE$(large%);"Total files available: ";ntotcnt%
  1204.       PRINT #1,SPACE$(large%);"Total file size      : ";nsz%;nsz$
  1205.       IF navsz%>0
  1206.         PRINT #1,SPACE$(large%);"Average file length  : ";navsz%;navsz$
  1207.       ENDIF
  1208.       PRINT #1
  1209.       PRINT #1,bord$
  1210.     ENDIF
  1211.     add_footer
  1212.     IF ft!
  1213.       PRINT #1
  1214.     ENDIF
  1215.     PRINT #1,logo$
  1216.     CLOSE #1
  1217.     newfoot!=FALSE
  1218.   ENDIF
  1219.   '
  1220. group_finish:
  1221.   IF grp_activate!
  1222.     @group_list_finish
  1223.   ENDIF
  1224.   '
  1225.   IF EXIST(footer$)
  1226.     ERASE foot$()
  1227.     ~FRE(0)
  1228.   ENDIF
  1229. RETURN
  1230. > PROCEDURE prep_pack
  1231.   @clean_memory
  1232.   @show_mem(STR$(FRE()))
  1233.   @clear
  1234.   '
  1235.   IF grp_only!
  1236.     GOTO move_group
  1237.   ENDIF
  1238.   '
  1239.   IF EXIST(newname$)=0
  1240.     nw!=FALSE
  1241.   ENDIF
  1242.   '
  1243.   IF keep!
  1244.     copy_file(allname$)
  1245.     IF nw!
  1246.       copy_file(newname$)
  1247.     ENDIF
  1248.   ENDIF
  1249.   '
  1250. move_group:
  1251.   IF grp_activate!
  1252.     @group_move
  1253.     IF grp_only!
  1254.       GOTO group_pack
  1255.     ENDIF
  1256.   ENDIF
  1257.   '
  1258.   IF lzh!
  1259.     lzh$="a "+arcpath$+allpack$+" "+allname$
  1260.     lzh$=CHR$(LEN(lzh$))+lzh$
  1261.     @clear
  1262.     display("Archiving "+allname$)
  1263.     packer(packlzh$,lzh$)
  1264.   ENDIF
  1265.   '
  1266.   IF lzh! AND nw!
  1267.     lzh$="a "+arcpath$+newpack$+" "+newname$
  1268.     lzh$=CHR$(LEN(lzh$))+lzh$
  1269.     @clear
  1270.     display("Archiving "+newname$)
  1271.     packer(packlzh$,lzh$)
  1272.   ENDIF
  1273.   '
  1274.   IF arc!
  1275.     arc$="a "+arcpath$+allpack$+" "+allname$
  1276.     arc$=CHR$(LEN(arc$))+arc$
  1277.     @clear
  1278.     display("Archiving "+allname$)
  1279.     packer(packarc$,arc$)
  1280.   ENDIF
  1281.   '
  1282.   IF arc! AND nw!
  1283.     arc$="a "+arcpath$+newpack$+" "+newname$
  1284.     arc$=CHR$(LEN(arc$))+arc$
  1285.     @clear
  1286.     display("Archiving "+newname$)
  1287.     packer(packarc$,arc$)
  1288.   ENDIF
  1289.   '
  1290.   IF zip!
  1291.     zip$="-a "+arcpath$+allpack$+" "+allname$
  1292.     zip$=CHR$(LEN(zip$))+zip$
  1293.     @clear
  1294.     display("Archiving "+allname$)
  1295.     packer(packzip$,zip$)
  1296.   ENDIF
  1297.   '
  1298.   IF zip! AND nw!
  1299.     zip$="-a "+arcpath$+newpack$+" "+newname$
  1300.     zip$=CHR$(LEN(zip$))+zip$
  1301.     @clear
  1302.     display("Archiving "+newname$)
  1303.     packer(packzip$,zip$)
  1304.   ENDIF
  1305.   '
  1306. group_pack:
  1307.   IF grp_activate!
  1308.     @group_prep_pack
  1309.   ENDIF
  1310.   '
  1311.   IF EXIST(allname$)
  1312.     KILL allname$
  1313.   ENDIF
  1314.   IF EXIST(newname$)
  1315.     KILL newname$
  1316.   ENDIF
  1317. RETURN
  1318. > PROCEDURE packer(pack$,archiver$)
  1319.   RESERVE 51200
  1320.   ~EXEC(0,pack$,archiver$,"")
  1321.   RESERVE
  1322. RETURN
  1323. > PROCEDURE update_list1
  1324.   '
  1325.   IF areafsize%>=1024
  1326.     asz%=INT(areafsize%/1024)
  1327.     sz$=" Kbytes."
  1328.   ELSE
  1329.     asz%=INT(areafsize%)
  1330.     sz$=" Kbytes"
  1331.   ENDIF
  1332.   '
  1333.   STORE #1,title$(),tcnt%
  1334.   PRINT #1,""
  1335.   STORE #1,info$(),cnt%
  1336.   IF stat!
  1337.     PRINT #1,""
  1338.     PRINT #1,SPACE$(24);"Number of files in this area: ";cnt%
  1339.     PRINT #1,SPACE$(24);"Total file size: ";asz%;sz$
  1340.   ENDIF
  1341.   PRINT #1,""
  1342. RETURN
  1343. > PROCEDURE update_list2
  1344.   IF nareafsize%>=1024
  1345.     nsz%=INT(nareafsize%/1024)
  1346.     sz$=" kbytes."
  1347.   ELSE
  1348.     nsz%=INT(nareafsize%)
  1349.     sz$=" bytes"
  1350.   ENDIF
  1351.   STORE #1,title$(),tcnt%
  1352.   PRINT #1,""
  1353.   STORE #1,info_new$(),cnt2%
  1354.   IF stat!
  1355.     PRINT #1,""
  1356.     PRINT #1,SPACE$(24);"Number of files in this area: ";cnt2%
  1357.     PRINT #1,SPACE$(24);"Total file size: ";nsz%;sz$
  1358.   ENDIF
  1359.   PRINT #1,""
  1360. RETURN
  1361. > PROCEDURE cmd_line
  1362.   LOCAL c!,s!
  1363.   c!=TRUE
  1364.   s!=TRUE
  1365.   cmdl%=BYTE{BASEPAGE+&H80}
  1366.   cmdl$=CHAR{BASEPAGE+&H81}
  1367.   cmdl$=UPPER$(cmdl$)
  1368.   ' cmdl%=0
  1369.   IF cmdl%>2
  1370.     a%=INSTR(TRIM$(cmdl$)," ")
  1371.     IF a%=0 OR cmdl%=a%
  1372.       display("Must be two parameters passed on the command line. Using default")
  1373.       display("control files.")
  1374.       display("")
  1375.     ELSE
  1376.       file1$=LEFT$(cmdl$,a%-1)
  1377.       file2$=RIGHT$(cmdl$,cmdl%-a%)
  1378.       IF LEFT$(file1$,2)="-C"
  1379.         ctl_file$=RIGHT$(file1$,LEN(file1$)-2)
  1380.         c!=FALSE
  1381.       ELSE IF LEFT$(file1$,2)="-S"
  1382.         search_file$=RIGHT$(file1$,LEN(file1$)-2)
  1383.         s!=FALSE
  1384.       ENDIF
  1385.       IF LEFT$(file2$,2)="-C"
  1386.         ctl_file$=RIGHT$(file2$,LEN(file2$)-2)
  1387.         c!=FALSE
  1388.       ELSE IF LEFT$(file2$,2)="-S"
  1389.         search_file$=RIGHT$(file2$,LEN(file2$)-2)
  1390.         s!=FALSE
  1391.       ENDIF
  1392.       IF c! OR s!
  1393.         display("Error entering parameters. Using default control files.")
  1394.         display("")
  1395.         search_file$="SEARCH.CTL"
  1396.         ctl_file$="LISTER.CTL"
  1397.       ENDIF
  1398.     ENDIF
  1399.   ENDIF
  1400. RETURN
  1401. > PROCEDURE topten(desc_cnt$,fname$)
  1402.   fnum%=0
  1403.   IF LEFT$(desc_cnt$,1)=bracket1$
  1404.     a|=INSTR(desc_cnt$,bracket2$)
  1405.     IF a|>0
  1406.       fnum$=MID$(desc_cnt$,2,a|-2)
  1407.       fnum%=VAL(fnum$)
  1408.       IF fnum%>0
  1409.         FOR ix%=0 TO tp%-1
  1410.           IF top%(ix%)<fnum%
  1411.             INSERT top%(ix%)=fnum%
  1412.             INSERT top$(ix%)=fname$
  1413.             INSERT topsize$(ix%)=fsize$(j%)
  1414.             INSERT topdesc$(ix%)=MID$(fldesc$,INSTR(fldesc$,bracket2$)+2,36)
  1415.             IF tc%<tp%-1
  1416.               INC tc%
  1417.             ENDIF
  1418.             mv!=TRUE
  1419.             EXIT IF mv!
  1420.           ENDIF
  1421.         NEXT ix%
  1422.         mv!=FALSE
  1423.       ENDIF
  1424.     ENDIF
  1425.   ENDIF
  1426. RETURN
  1427. > PROCEDURE pro_topten(fname$,fnum%)
  1428.   IF fnum%>0
  1429.     FOR ix%=0 TO tp%-1
  1430.       IF top%(ix%)<fnum%
  1431.         INSERT top%(ix%)=fnum%
  1432.         INSERT top$(ix%)=fname$
  1433.         INSERT topsize$(ix%)=fsize$(j%)
  1434.         INSERT topdesc$(ix%)=LEFT$(fldesc$,36)
  1435.         IF tc%<tp%-1
  1436.           INC tc%
  1437.         ENDIF
  1438.         mv!=TRUE
  1439.         EXIT IF mv!
  1440.       ENDIF
  1441.     NEXT ix%
  1442.     mv!=FALSE
  1443.   ENDIF
  1444. RETURN
  1445. > PROCEDURE make_date(fdate%)
  1446.   IF fdate%>today% OR fdate%<33
  1447.     @logit("Filedate for "+fname$(j%)+" out of range!")
  1448.     IF fixdate!
  1449.       OPEN "u",#3,path$+fname$(j%)
  1450.       TOUCH #3
  1451.       CLOSE #3
  1452.       @logit(path$+fname$(j%)+" has had date fixed.")
  1453.     ELSE
  1454.       @logit("File will be given today's date in the allfiles lists.")
  1455.     ENDIF
  1456.     fdate%=today%
  1457.   ENDIF
  1458.   day%=fdate% AND &X11111
  1459.   fdate%=SHR(fdate%,5)
  1460.   mth%=fdate% AND &X1111
  1461.   fdate%=SHR(fdate%,4)
  1462.   yr%=(fdate% AND &X1111111)+1980
  1463.   day$=STR$(day%,2)
  1464.   mth$=STR$(mth%,2)
  1465.   IF day%<10
  1466.     MID$(day$,1)="0"
  1467.   ENDIF
  1468.   IF mth%<10
  1469.     MID$(mth$,1)="0"
  1470.   ENDIF
  1471.   fdate$=day$+"/"+mth$+"/"+RIGHT$(STR$(yr%,4),2)
  1472. RETURN
  1473. '
  1474. ' Miscellaneous general routines
  1475. '
  1476. > PROCEDURE display(show$)
  1477.   IF lc%<25
  1478.     PRINT AT(1,lc%);show$
  1479.   ELSE
  1480.     PRINT AT(1,6);"M"
  1481.     PRINT AT(1,24);show$
  1482.   ENDIF
  1483.   INC lc%
  1484. RETURN
  1485. > PROCEDURE show_mem(mem$)
  1486.   IF smem!
  1487.     PRINT AT(55,5);"Free memory "+mem$+" bytes."
  1488.   ENDIF
  1489. RETURN
  1490. > PROCEDURE took_how_long
  1491.   @clear
  1492.   time%=(TIMER-t%)/200
  1493.   WHILE time%>59
  1494.     INC minute%
  1495.     time%=time%-60
  1496.   WEND
  1497.   IF time%=1
  1498.     sec$="second"
  1499.   ELSE
  1500.     sec$="seconds"
  1501.   ENDIF
  1502.   IF minute%=1
  1503.     display("")
  1504.     display("List took "+STR$(minute%)+" minute "+STR$(time%)+" "+sec$+" to compile.")
  1505.   ELSE IF minute%>1
  1506.     display("")
  1507.     display("List took "+STR$(minute%)+" minutes "+STR$(time%)+" "+sec$+" to compile.")
  1508.   ELSE
  1509.     display("")
  1510.     display("List took "+STR$(time%)+" "+sec$+" to compile.")
  1511.   ENDIF
  1512.   PAUSE 50
  1513. RETURN
  1514. > PROCEDURE omit_files
  1515.   INC c%
  1516.   WHILE LEFT$(lster$(c%),7)<>"ENDOMIT"
  1517.     IF LEFT$(lster$(c%),1)<>";"
  1518.       omitfile$=omitfile$+TRIM$(lster$(c%))
  1519.     ENDIF
  1520.     INC c%
  1521.   WEND
  1522. RETURN
  1523. > PROCEDURE copy_file(copy$)
  1524.   IF arcpath$<>origpath$
  1525.     display("Copying "+copy$+" to "+arcpath$+copy$)
  1526.     OPEN "i",#1,copy$
  1527.     OPEN "o",#2,arcpath$+copy$
  1528.     l%=LOF(#1)
  1529.     WHILE l%>32000
  1530.       PRINT #2,INPUT$(32000,#1);
  1531.       SUB l%,32000
  1532.     WEND
  1533.     PRINT #2,INPUT$(l%,#1);
  1534.     CLOSE #1
  1535.     CLOSE #2
  1536.   ENDIF
  1537. RETURN
  1538. > PROCEDURE clear
  1539.   PRINT AT(1,6);"J"
  1540.   lc%=6
  1541. RETURN
  1542. > PROCEDURE clean_memory
  1543.   ERASE numareas%(),top%(),top$(),topsize$(),topdesc$()
  1544.   ~FRE(0)
  1545. RETURN
  1546. > PROCEDURE g_clean_memory
  1547.   ERASE g_top%(),g_top$(),g_topsize$(),g_topdesc$()
  1548.   ~FRE(0)
  1549. RETURN
  1550. > PROCEDURE backslash(VAR backslash$)
  1551.   IF RIGHT$(backslash$)<>"\"
  1552.     backslash$=backslash$+"\"
  1553.   ENDIF
  1554. RETURN
  1555. > PROCEDURE logit(log$)
  1556.   IF logit!
  1557.     IF EXIST(logpath$)
  1558.       OPEN "a",#2,logpath$
  1559.     ELSE
  1560.       MODE 3
  1561.       OPEN "o",#2,logpath$
  1562.       PRINT #2,"--------------------------------------------------"
  1563.       PRINT #2,"LiSTer "+version$+" Log - Created on "+MID$(DATE$,4,3)+LEFT$(DATE$,3)+RIGHT$(DATE$,2)+" at "+TIME$
  1564.       PRINT #2,"--------------------------------------------------"
  1565.       PRINT #2
  1566.     ENDIF
  1567.     PRINT #2,log$
  1568.     CLOSE #2
  1569.   ENDIF
  1570. RETURN
  1571. > PROCEDURE debug(debug$)
  1572.   ' debug$ is limited to 68 characters.
  1573.   OPEN "a",#2,dblog$
  1574.   MODE 3
  1575.   IF blank!
  1576.     PRINT #2
  1577.   ENDIF
  1578.   PRINT #2,MID$(DATE$,4,3)+LEFT$(DATE$,2)+" "+LEFT$(TIME$,5)+" "+debug$
  1579.   CLOSE #2
  1580. RETURN
  1581. > PROCEDURE error_trapping
  1582.   display(ERR$(ERR))
  1583.   IF FATAL=FALSE
  1584.     IF ERR=37 AND drv$=l_drv$
  1585.       GOTO escape_clause
  1586.     ELSE
  1587.       logit!=TRUE
  1588.       logit(ERR$(ERR))
  1589.     ENDIF
  1590.   ENDIF
  1591. escape_clause:
  1592.   finish(ERR)
  1593. RETURN
  1594. > PROCEDURE breakout
  1595.   finish(0)
  1596. RETURN
  1597. > PROCEDURE finish(f%)
  1598.   CLEAR
  1599.   SHOWM
  1600.   ~FRE(0)
  1601.   EDIT
  1602.   QUIT f%
  1603. RETURN
  1604. > FUNCTION fullpath$(d$)
  1605.   LOCAL cwd$,ret$
  1606.   cwd$=CHR$(ASC("A")+GEMDOS(25))+":"+DIR$(0)
  1607.   IF MID$(d$,2,1)=":"
  1608.     IF (BIOS(10) AND 2^(ASC(UPPER$(d$))-65))=0
  1609.       logit!=-1
  1610.       logit("!Drive "+LEFT$(d$)+" doesn't exist!")
  1611.       QUIT 1
  1612.     ENDIF
  1613.     CHDRIVE d$
  1614.     d$=MID$(d$,3)
  1615.   ENDIF
  1616.   IF LEFT$(d$)="\"
  1617.     CHDIR "\"
  1618.     d$=MID$(d$,2)
  1619.   ENDIF
  1620.   DO WHILE d$>""
  1621.     IF INSTR(d$,"\")
  1622.       c$=LEFT$(d$,INSTR(d$,"\")-1)
  1623.       d$=MID$(d$,INSTR(d$,"\")+1)
  1624.     ELSE
  1625.       c$=d$
  1626.       d$=""
  1627.     ENDIF
  1628.     IF FSFIRST(c$,16) AND c$<>"."
  1629.       MKDIR c$
  1630.     ENDIF
  1631.     CHDIR c$
  1632.   LOOP
  1633.   ret$=CHR$(ASC("A")+GEMDOS(25))+":"+DIR$(0)
  1634.   CHDRIVE cwd$
  1635.   CHDIR cwd$
  1636.   RETURN ret$+"\"
  1637. ENDFUNC
  1638. '
  1639. ' Group handling operations
  1640. '
  1641. > PROCEDURE group_data
  1642.   group$(grp%)=RIGHT$(lster$(c%),1)
  1643.   INC c%
  1644.   REPEAT
  1645.     '
  1646.     IF LEFT$(UPPER$(lster$(c%)),7)="ALLNAME"
  1647.       a%=INSTR(lster$(c%)," ")
  1648.       WHILE MID$(lster$(c%),a%,1)=" "
  1649.         INC a%
  1650.       WEND
  1651.       g_allname$(grp%)=UPPER$(MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1))
  1652.       IF INSTR(RIGHT$(g_allname$(grp%),4),".")=0
  1653.         g_allpack$(grp%)=g_allname$(grp%)
  1654.         g_allname$(grp%)=g_allpack$(grp%)+".TXT"
  1655.       ELSE
  1656.         g_allpack$(grp%)=LEFT$(g_allname$(grp%),INSTR(g_allname$(grp%),".")-1)
  1657.       ENDIF
  1658.     ENDIF
  1659.     '
  1660.     IF LEFT$(UPPER$(lster$(c%)),7)="NEWNAME"
  1661.       a%=INSTR(lster$(c%)," ")
  1662.       WHILE MID$(lster$(c%),a%,1)=" "
  1663.         INC a%
  1664.       WEND
  1665.       g_newname$(grp%)=UPPER$(MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1))
  1666.       IF INSTR(RIGHT$(g_newname$(grp%),4),".")=0
  1667.         g_newpack$(grp%)=g_newname$(grp%)
  1668.         g_newname$(grp%)=g_newpack$(grp%)+".TXT"
  1669.       ELSE
  1670.         g_newpack$(grp%)=LEFT$(g_newname$(grp%),INSTR(g_newname$(grp%),".")-1)
  1671.       ENDIF
  1672.       gnw!(grp%)=TRUE
  1673.       ' Make a Newfiles list too.
  1674.     ENDIF
  1675.     '
  1676.     IF LEFT$(UPPER$(lster$(c%)),8)="KEEPPATH"
  1677.       a%=INSTR(lster$(c%)," ")
  1678.       WHILE MID$(lster$(c%),a%,1)=" "
  1679.         INC a%
  1680.       WEND
  1681.       g_arcpath$(grp%)=UPPER$(MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1))
  1682.       IF RIGHT$(g_arcpath$(grp%),1)<>"\"
  1683.         g_arcpath$(grp%)=g_arcpath$(grp%)+"\"
  1684.       ENDIF
  1685.       g_allfile$(grp%)=g_arcpath$(grp%)+g_allname$(grp%)
  1686.       g_newfile$(grp%)=g_arcpath$(grp%)+g_newname$(grp%)
  1687.       ' This is where the lists are saved.
  1688.     ENDIF
  1689.     '
  1690.     IF LEFT$(UPPER$(lster$(c%)),8)="KEEPLIST"
  1691.       keep!(grp%)=TRUE
  1692.       ' Don't delete the ascii lists!
  1693.     ENDIF
  1694.     '
  1695.     IF LEFT$(UPPER$(lster$(c%)),6)="HEADER"
  1696.       a%=INSTR(lster$(c%)," ")
  1697.       WHILE MID$(lster$(c%),a%,1)=" "
  1698.         INC a%
  1699.       WEND
  1700.       g_header$(grp%)=UPPER$(MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1))
  1701.     ENDIF
  1702.     '
  1703.     IF LEFT$(UPPER$(lster$(c%)),9)="NEWHEADER"
  1704.       a%=INSTR(lster$(c%)," ")
  1705.       WHILE MID$(lster$(c%),a%,1)=" "
  1706.         INC a%
  1707.       WEND
  1708.       g_newheader$(grp%)=UPPER$(MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1))
  1709.       newhead!(grp%)=TRUE
  1710.     ENDIF
  1711.     '
  1712.     IF LEFT$(UPPER$(lster$(c%)),5)="MAGIC"
  1713.       a%=INSTR(lster$(c%)," ")
  1714.       WHILE MID$(lster$(c%),a%,1)=" "
  1715.         INC a%
  1716.       WEND
  1717.       g_magic$(grp%)=UPPER$(MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1))
  1718.     ENDIF
  1719.     '
  1720.     IF LEFT$(UPPER$(lster$(c%)),7)="ARCLIST"
  1721.       arc!(grp%)=TRUE
  1722.       ' ARC the allfiles list(s)
  1723.     ENDIF
  1724.     '
  1725.     IF LEFT$(UPPER$(lster$(c%)),7)="LZHLIST"
  1726.       lzh!(grp%)=TRUE
  1727.       ' LZH the allfiles list(s)
  1728.     ENDIF
  1729.     '
  1730.     IF LEFT$(UPPER$(lster$(c%)),7)="ZIPLIST"
  1731.       zip!(grp%)=TRUE
  1732.       ' ZIP the allfiles list(s)
  1733.     ENDIF
  1734.     '
  1735.     IF LEFT$(UPPER$(lster$(c%)),7)="TOPTEN"
  1736.       tt!(grp%)=TRUE
  1737.       gtp%(grp%)=10
  1738.       ' Include Top Ten list to Allfiles list.
  1739.     ENDIF
  1740.     '
  1741.     IF LEFT$(UPPER$(lster$(c%)),8)="TOPTITLE"
  1742.       a%=INSTR(lster$(c%)," ")
  1743.       WHILE MID$(lster$(c%),a%,1)=" "
  1744.         INC a%
  1745.       WEND
  1746.       toptitle$(grp%)=TRIM$(LEFT$(MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1),74))
  1747.     ENDIF
  1748.     '
  1749.     IF LEFT$(UPPER$(lster$(c%)),7)="LISTTOP"
  1750.       a%=INSTR(lster$(c%),"$")
  1751.       gtp%(grp%)=VAL(MID$(lster$(c%),a%+1,LEN(lster$(c%))-a%))
  1752.       '
  1753.       IF gtp%(grp%)=0
  1754.         gtp%(grp%)=10
  1755.       ENDIF
  1756.       '
  1757.       IF gtp%(grp%)>50
  1758.         gtp%(grp%)=50
  1759.       ENDIF
  1760.       '
  1761.     ENDIF
  1762.     '
  1763.     IF LEFT$(UPPER$(lster$(c%)),12)="WRITE TOPTEN"
  1764.       a%=RINSTR(lster$(c%)," ")
  1765.       WHILE MID$(lster$(c%),a%,1)=" "
  1766.         INC a%
  1767.       WEND
  1768.       outtp$(grp%)=MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1)
  1769.       '
  1770.       IF RIGHT$(outtp$(grp%),1)<>"\"
  1771.         outtp$(grp%)=outtp$(grp%)+"\"
  1772.       ENDIF
  1773.       '
  1774.       outtp$(grp%)=outtp$(grp%)+"TOP_"+STR$(gtp%(grp%))+"_"+group$(grp%)
  1775.       IF tt!(grp%)
  1776.         otp!(grp%)=TRUE
  1777.       ENDIF
  1778.     ENDIF
  1779.     '
  1780.     INC c%
  1781.   UNTIL LEFT$(UPPER$(lster$(c%)),8)="GROUPEND" OR c%=n%
  1782.   INC grp%
  1783.   grp_activate!=TRUE
  1784. RETURN
  1785. > PROCEDURE group_headers
  1786.   FOR i%=0 TO grp%-1
  1787.     IF EXIST(g_header$(i%))
  1788.       DIM g_head$(300)
  1789.       OPEN "i",#1,g_header$(i%)
  1790.       RECALL #1,g_head$(),-1,hdr%
  1791.       CLOSE #1
  1792.       OPEN "o",#1,g_allname$(i%)
  1793.       STORE #1,g_head$(),hdr%
  1794.       CLOSE #1
  1795.     ENDIF
  1796.     '
  1797.     IF newhead!(i%) AND gnw!(i%)
  1798.       IF EXIST(g_newheader$(i%))
  1799.         DIM g_newhead$(300)
  1800.         OPEN "i",#1,g_newheader$(i%)
  1801.         RECALL #1,g_newhead$(),-1,hdr%
  1802.         CLOSE #1
  1803.         nh!(i%)=TRUE          !Alternative header file for newfiles list.
  1804.       ENDIF
  1805.     ENDIF
  1806.     '
  1807.     IF gnw!(i%)
  1808.       OPEN "O",#1,g_newname$(i%)
  1809.       IF nh!(i%)
  1810.         STORE #1,g_newhead$(),hdr%
  1811.       ELSE
  1812.         STORE #1,g_head$(),hdr%
  1813.       ENDIF
  1814.       CLOSE #1
  1815.     ENDIF
  1816.     '
  1817.     ERASE g_head$(),g_newhead$()
  1818.     ~FRE(0)
  1819.   NEXT i%
  1820. RETURN
  1821. > PROCEDURE group_magics
  1822.   FOR i%=0 TO grp%-1
  1823.     IF EXIST(g_magic$(i%))
  1824.       DIM gmagic$(300)
  1825.       OPEN "i",#1,g_magic$(i%)
  1826.       RECALL #1,gmagic$(),-1,mag2%
  1827.       CLOSE #1
  1828.     ENDIF
  1829.     '
  1830.     IF EXIST(g_allname$(i%))
  1831.       OPEN "a",#1,g_allname$(i%)
  1832.       STORE #1,gmagic$(),mag2%
  1833.       CLOSE #1
  1834.     ELSE
  1835.       OPEN "o",#1,g_allname$(i%)
  1836.       STORE #1,gmagic$(),mag2%
  1837.       CLOSE #1
  1838.     ENDIF
  1839.     '
  1840.     IF gnw!(i%)
  1841.       IF EXIST(g_newname$(i%))
  1842.         OPEN "a",#1,g_newname$(i%)
  1843.         STORE #1,gmagic$(),mag2%
  1844.         CLOSE #1
  1845.       ELSE
  1846.         OPEN "o",#1,g_newname$(i%)
  1847.         STORE #1,gmagic$(),mag2%
  1848.         CLOSE #1
  1849.       ENDIF
  1850.     ENDIF
  1851.     '
  1852.     ERASE gmagic$()
  1853.     ~FRE(0)
  1854.   NEXT i%
  1855. RETURN
  1856. > PROCEDURE group_output_file_lists
  1857.   IF grn!
  1858.     make_date(GEMDOS(42))
  1859.     FOR i%=0 TO grp%-1
  1860.       IF EXIST(g_allname$(i%))
  1861.         OPEN "a",#1,g_allname$(i%)
  1862.       ELSE
  1863.         OPEN "o",#1,g_allname$(i%)
  1864.       ENDIF
  1865.       PRINT #1,"List created : ";fdate$
  1866.       PRINT #1,"Files marked with a '*' are new in the last ";STR$(numdays%);" days."
  1867.       PRINT #1,""
  1868.       CLOSE #1
  1869.     NEXT i%
  1870.     grn!=FALSE
  1871.   ENDIF
  1872.   '
  1873.   FOR i%=0 TO grp%-1
  1874.     IF INSTR(group$,group$(i%))>0
  1875.       IF EXIST(g_allname$(i%))
  1876.         OPEN "a",#1,g_allname$(i%)
  1877.         update_list1
  1878.         CLOSE #1
  1879.         INC numareas%(i%)
  1880.         mt%(i%)=mt%(i%)+md%+mf%
  1881.         totcnt%(i%)=totcnt%(i%)+cnt%
  1882.         totfilesize%(i%)=totfilesize%(i%)+areafsize%
  1883.       ENDIF
  1884.       IF cnt2%>0
  1885.         IF EXIST(g_newname$(i%))
  1886.           OPEN "a",#1,g_newname$(i%)
  1887.           update_list2
  1888.           CLOSE #1
  1889.           ntotcnt%(i%)=ntotcnt%(i%)+cnt2%
  1890.           totnfilesize%(i%)=totnfilesize%(i%)+nareafsize%
  1891.         ENDIF
  1892.       ENDIF
  1893.     ENDIF
  1894.   NEXT i%
  1895. RETURN
  1896. > PROCEDURE group_list_finish
  1897.   FOR i%=0 TO grp%-1
  1898.     asz%=0
  1899.     nsz%=0
  1900.     avsz%=0
  1901.     navsz%=0
  1902.     asz$=""
  1903.     nsz$=""
  1904.     avsz$=""
  1905.     navsz$=""
  1906.     '
  1907.     IF totfilesize%(i%)>=1024
  1908.       asz%=INT(totfilesize%(i%)/1024)
  1909.       asz$=" Kbytes."
  1910.       '
  1911.     ELSE
  1912.       asz%=INT(totfilesize%(i%))
  1913.       asz$=" bytes"
  1914.     ENDIF
  1915.     '
  1916.     IF totcnt%(i%)>0
  1917.       avsz%=INT(totfilesize%(i%)/totcnt%(i%))
  1918.       IF avsz%>=1024
  1919.         avsz%=avsz%/1024
  1920.         avsz$=" Kbytes."
  1921.       ELSE
  1922.         avsz$=" bytes."
  1923.       ENDIF
  1924.     ENDIF
  1925.     '
  1926.     IF totnfilesize%(i%)>=1024
  1927.       nsz%=INT(totnfilesize%(i%)/1024)
  1928.       nsz$=" Kbytes."
  1929.     ELSE
  1930.       nsz%=INT(totnfilesize%(i%))
  1931.       nsz$=" bytes"
  1932.     ENDIF
  1933.     '
  1934.     IF ntotcnt%(i%)>0
  1935.       navsz%=INT(totnfilesize%(i%)/ntotcnt%(i%))
  1936.       IF navsz%>=1024
  1937.         navsz%=navsz%/1024
  1938.         navsz$=" Kbytes."
  1939.       ELSE
  1940.         navsz$=" bytes."
  1941.       ENDIF
  1942.     ENDIF
  1943.     '
  1944.     large$="Largest file is "+g_bigfile$(i%)+" at "+STR$(g_max%(i%))+" bytes."
  1945.     small$="Smallest file is "+g_smallfile$(i%)+" at "+STR$(g_min%(i%))+" bytes."
  1946.     large%=(80-LEN(large$))/2
  1947.     large$=SPACE$(large%)+large$
  1948.     small$=SPACE$(large%)+small$
  1949.     '
  1950.     IF EXIST(g_allname$(i%))
  1951.       all!=TRUE
  1952.       OPEN "a",#1,g_allname$(i%)
  1953.       IF stat!
  1954.         PRINT #1,bord$
  1955.         PRINT #1
  1956.         PRINT #1,SPACE$(pad%);"Total files available: ";totcnt%(i%)
  1957.         PRINT #1,SPACE$(pad%);"Total file size      : ";asz%;asz$
  1958.         PRINT #1,SPACE$(pad%);"Number of areas      : ";numareas%(i%)
  1959.         IF avsz%>0
  1960.           PRINT #1,SPACE$(pad%);"Average file length  : ";avsz%;avsz$
  1961.         ENDIF
  1962.         IF mi!
  1963.           PRINT #1,SPACE$(pad%);"Descriptions missing : ";mt%(i%)
  1964.         ENDIF
  1965.         PRINT #1
  1966.         PRINT #1,large$
  1967.         PRINT #1,small$
  1968.         IF tt!(i%)
  1969.           PRINT #1
  1970.           PRINT #1,SPACE$(16);"Top ";STR$(gtp%(i%));" most popular files on this system are..."
  1971.           PRINT #1
  1972.           PRINT #1,SPACE$(20);"Position  Filename       Number of d/l's"
  1973.           PRINT #1
  1974.           FOR l%=0 TO tc%(i%)
  1975.             IF g_top$(l%,i%)=""
  1976.               GOTO no_name
  1977.             ENDIF
  1978.             LSET fttop$=g_top$(l%,i%)
  1979.             PRINT #1,SPACE$(19);STR$(l%+1,6);".    ";fttop$;"     ";STR$(g_top%(l%,i%),6)
  1980.           no_name:
  1981.           NEXT l%
  1982.           PRINT #1
  1983.         ENDIF
  1984.         PRINT #1,bord$
  1985.       ENDIF
  1986.       add_footer
  1987.       IF ft!
  1988.         PRINT #1
  1989.       ENDIF
  1990.       PRINT #1,logo$
  1991.       CLOSE #1
  1992.       all!=FALSE
  1993.     ENDIF
  1994.     '
  1995.     IF otp!(i%)
  1996.       IF fourtops!
  1997.         tx%=3
  1998.       ELSE
  1999.         tx%=0
  2000.       ENDIF
  2001.       '
  2002.       FOR b%=0 TO tx%
  2003.         '
  2004.         IF b%=0           ! Straight ASCII output
  2005.           ext$=".ASC"
  2006.         ELSE IF b%=1      ! Mono output
  2007.           ext$=".VTM"
  2008.         ELSE IF b%=2      ! Colour output
  2009.           ext$=".VTC"
  2010.         ELSE
  2011.           ext$=".ANS"     ! ANSI output
  2012.         ENDIF
  2013.         '
  2014.         hdl$=" "+g$(b%)+be$(b%)+b$(b%)+br$(b%)+" No. "+bc$(b%)+g$(b%)+be$(b%)+b$(b%)+"  "+br$(b%)+" Filename "+bc$(b%)+"  "+g$(b%)+be$(b%)+b$(b%)+" "+br$(b%)+" Size "+bc$(b%)+"  "+g$(b%)+be$(b%)+b$(b%)+br$(b%)+" DL'd "+bc$(b%)+g$(b%)+be$(b%)+b$(b%)
  2015.         hdl$=hdl$+" "+br$(b%)+" Description "+bc$(b%)+SPACE$(24)+g$(b%)+be$(b%)+b$(b%)
  2016.         tsepl$=" "+g$(b%)+besl$(b%)+STRING$(5,bse$(b%))+bts$(b%)+STRING$(14,bse$(b%))+bts$(b%)+STRING$(9,bse$(b%))+bts$(b%)+STRING$(6,bse$(b%))+bts$(b%)+STRING$(38,bse$(b%))+besr$(b%)+b$(b%)
  2017.         sepl$=" "+g$(b%)+besl$(b%)+STRING$(5,bse$(b%))+bcs$(b%)+STRING$(14,bse$(b%))+bcs$(b%)+STRING$(9,bse$(b%))+bcs$(b%)+STRING$(6,bse$(b%))+bcs$(b%)+STRING$(38,bse$(b%))+besr$(b%)+b$(b%)
  2018.         '
  2019.         IF toptitle$(i%)=""
  2020.           topadd$=SPACE$(11)+"The Top "+STR$(gtp%(i%),2)+" Chart - created on "+DATE$+" at "+TIME$+SPACE$(11)
  2021.         ELSE
  2022.           IF LEN(toptitle$(i%)) MOD 2=1
  2023.             padit|=1
  2024.           ELSE
  2025.             padit|=0
  2026.           ENDIF
  2027.           spc%=(74-LEN(toptitle$))/2
  2028.           spc2%=spc%+padit|
  2029.           topadd$=SPACE$(spc%)+toptitle$(i%)+SPACE$(spc2%)
  2030.         ENDIF
  2031.         topper$=" "+g$(b%)+be$(b%)+b$(b%)+" "+br$(b%)+topadd$+bc$(b%)+" "+g$(b%)+be$(b%)+b$(b%)
  2032.         '
  2033.         display("Writing "+outtp$(i%)+ext$)
  2034.         OPEN "o",#1,outtp$(i%)+ext$
  2035.         PRINT #1,"  ";g$(b%);btl$(b%);STRING$(76,bse$(b%));btr$(b%);b$(b%)
  2036.         PRINT #1,topper$
  2037.         PRINT #1,tsepl$
  2038.         PRINT #1,hdl$
  2039.         PRINT #1,sepl$
  2040.         FOR l%=0 TO tc%(i%)
  2041.           IF g_top$(l%,i%)=""
  2042.             GOTO no_name2
  2043.           ENDIF
  2044.           LSET fttop$=g_top$(l%,i%)
  2045.           RSET ftsize$=g_topsize$(l%,i%)
  2046.           LSET ftdesc$=g_topdesc$(l%,i%)
  2047.           PRINT #1," ";g$(b%);be$(b%);r$(b%);STR$(l%+1,3);". ";g$(b%);be$(b%);b$(b%);" ";fttop$;g$(b%);be$(b%);" ";r$(b%);ftsize$;b$(b%);" ";g$(b%);be$(b%);" ";r$(b%);STR$(g_top%(l%,i%),4);g$(b%);" ";be$(b%);b$(b%);" ";ftdesc$;" ";g$(b%);be$(b%);b$(b%)
  2048.         no_name2:
  2049.         NEXT l%
  2050.         PRINT #1," ";g$(b%);besl$(b%);STRING$(5,bse$(b%));bbs$(b%);STRING$(14,bse$(b%));bbs$(b%);STRING$(9,bse$(b%));bbs$(b%);STRING$(6,bse$(b%));bbs$(b%);STRING$(38,bse$(b%));besr$(b%);b$(b%)
  2051.         PRINT #1," ";g$(b%);be$(b%);b$(b%);SPACE$(6);"Top ";STR$(gtp%(i%),2);" produced by ";br$(b%);" LiSTer V";version$;" ";bc$(b%);" (c)1993/94 by Robert Darling.";SPACE$(7);g$(b%);be$(b%);b$(b%)
  2052.         PRINT #1," ";g$(b%);bbl$(b%);STRING$(76,bse$(b%));bbr$(b%);b$(b%)
  2053.         '
  2054.         CLOSE #1
  2055.       NEXT b%
  2056.     ENDIF
  2057.     '
  2058.     '
  2059.     IF EXIST(g_newname$(i%)) AND gnw!(i%)
  2060.       newfoot!=TRUE
  2061.       OPEN "a",#1,g_newname$(i%)
  2062.       IF stat!
  2063.         PRINT #1,bord$
  2064.         PRINT #1
  2065.         PRINT #1,SPACE$(large%);"Total files available: ";ntotcnt%(i%)
  2066.         PRINT #1,SPACE$(large%);"Total file size      : ";nsz%;nsz$
  2067.         IF navsz%>0
  2068.           PRINT #1,SPACE$(large%);"Average file length  : ";navsz%;navsz$
  2069.         ENDIF
  2070.         PRINT #1
  2071.         PRINT #1,bord$
  2072.       ENDIF
  2073.       add_footer
  2074.       IF ft!
  2075.         PRINT #1
  2076.       ENDIF
  2077.       PRINT #1,logo$
  2078.       CLOSE #1
  2079.       newfoot!=FALSE
  2080.     ENDIF
  2081.   NEXT i%
  2082. RETURN
  2083. > PROCEDURE group_move
  2084.   FOR i%=0 TO grp%-1
  2085.     IF EXIST(g_newname$(i%))=0
  2086.       gnw!(i%)=FALSE
  2087.     ENDIF
  2088.     IF keep!(i%)
  2089.       group_copy_file(g_allname$(i%))
  2090.       IF gnw!(i%)
  2091.         group_copy_file(g_newname$(i%))
  2092.       ENDIF
  2093.     ENDIF
  2094.   NEXT i%
  2095. RETURN
  2096. > PROCEDURE group_prep_pack
  2097.   @g_clean_memory
  2098.   @show_mem(STR$(FRE()))
  2099.   '
  2100.   FOR i%=0 TO grp%-1
  2101.     IF lzh!(i%)
  2102.       lzh$="a "+g_arcpath$(i%)+g_allpack$(i%)+" "+g_allname$(i%)
  2103.       lzh$=CHR$(LEN(lzh$))+lzh$
  2104.       @clear
  2105.       display("Archiving "+g_allname$(i%))
  2106.       packer(packlzh$,lzh$)
  2107.     ENDIF
  2108.     IF lzh!(i%) AND gnw!(i%)
  2109.       lzh$="a "+g_arcpath$(i%)+g_newpack$(i%)+" "+g_newname$(i%)
  2110.       lzh$=CHR$(LEN(lzh$))+lzh$
  2111.       @clear
  2112.       display("Archiving "+g_newname$(i%))
  2113.       packer(packlzh$,lzh$)
  2114.     ENDIF
  2115.     IF arc!(i%)
  2116.       arc$="a "+g_arcpath$(i%)+g_allpack$(i%)+" "+g_allname$(i%)
  2117.       arc$=CHR$(LEN(arc$))+arc$
  2118.       @clear
  2119.       display("Archiving "+g_allname$(i%))
  2120.       packer(packarc$,arc$)
  2121.     ENDIF
  2122.     IF arc!(i%) AND gnw!(i%)
  2123.       arc$="a "+g_arcpath$(i%)+g_newpack$(i%)+" "+g_newname$(i%)
  2124.       arc$=CHR$(LEN(arc$))+arc$
  2125.       @clear
  2126.       display("Archiving "+g_newname$(i%))
  2127.       packer(packarc$,arc$)
  2128.     ENDIF
  2129.     IF zip!(i%)
  2130.       zip$="-a "+g_arcpath$(i%)+g_allpack$(i%)+" "+g_allname$(i%)
  2131.       zip$=CHR$(LEN(zip$))+zip$
  2132.       @clear
  2133.       display("Archiving "+g_allname$(i%))
  2134.       packer(packzip$,zip$)
  2135.     ENDIF
  2136.     IF zip!(i%) AND gnw!(i%)
  2137.       zip$="-a "+g_arcpath$(i%)+g_newpack$(i%)+" "+g_newname$(i%)
  2138.       zip$=CHR$(LEN(zip$))+zip$
  2139.       @clear
  2140.       display("Archiving "+g_newname$(i%))
  2141.       packer(packzip$,zip$)
  2142.     ENDIF
  2143.   NEXT i%
  2144.   '
  2145.   FOR i%=0 TO grp%-1
  2146.     IF EXIST(g_allname$(i%))
  2147.       KILL g_allname$(i%)
  2148.     ENDIF
  2149.     IF EXIST(g_newname$(i%))
  2150.       KILL g_newname$(i%)
  2151.     ENDIF
  2152.   NEXT i%
  2153. RETURN
  2154. > PROCEDURE group_copy_file(copy$)
  2155.   IF g_arcpath$(i%)<>origpath$
  2156.     display("Copying "+copy$+" to "+g_arcpath$(i%)+copy$)
  2157.     OPEN "i",#1,copy$
  2158.     OPEN "o",#2,g_arcpath$(i%)+copy$
  2159.     l%=LOF(#1)
  2160.     WHILE l%>32000
  2161.       PRINT #2,INPUT$(32000,#1);
  2162.       SUB l%,32000
  2163.     WEND
  2164.     PRINT #2,INPUT$(l%,#1);
  2165.     CLOSE #1
  2166.     CLOSE #2
  2167.   ENDIF
  2168. RETURN
  2169. > PROCEDURE group_topten
  2170.   '
  2171.   FOR jj%=0 TO grp%-1           ! Got to cover all groups
  2172.     '
  2173.     IF INSTR(group$,group$(jj%))=0
  2174.       GOTO next_group
  2175.     ENDIF
  2176.     '
  2177.     IF tt!(jj%)                 ! But only create top 10 for those asked for...
  2178.       '
  2179.       FOR kk%=0 TO gtp%(jj%)-1                   ! Position checking!
  2180.         '
  2181.         IF g_top%(kk%,jj%)<fnum%                 ! Only works if d/l count is
  2182.           '                                      ! higher than any others.
  2183.           '
  2184.           IF tc%(jj%)>0                          ! Only as many as needed!!!
  2185.             FOR xx%=tc%(jj%) TO kk%+1 STEP -1    ! Have to manually move array
  2186.               g_top%(xx%,jj%)=g_top%(xx%-1,jj%)  ! elements up as INSERT command
  2187.               g_top$(xx%,jj%)=g_top$(xx%-1,jj%)  ! only works with single
  2188.               g_topsize$(xx%,jj%)=g_topsize$(xx%-1,jj%)
  2189.               g_topdesc$(xx%,jj%)=g_topdesc$(xx%-1,jj%)
  2190.             NEXT xx%                             ! dimension arrays.
  2191.           ENDIF
  2192.           '
  2193.           g_top%(kk%,jj%)=fnum%                  ! Insert new data....
  2194.           g_top$(kk%,jj%)=fname$
  2195.           g_topsize$(kk%,jj%)=fsize$(j%)
  2196.           IF probbs!
  2197.             g_topdesc$(kk%,jj%)=LEFT$(fldesc$,36)
  2198.           ELSE
  2199.             g_topdesc$(kk%,jj%)=MID$(fldesc$,(INSTR(fldesc$,bracket2$)+2),36)
  2200.           ENDIF
  2201.           '
  2202.           IF tc%(jj%)<gtp%(jj%)-1                ! Keep a tab on postion count.
  2203.             INC tc%(jj%)                         ! we only want top ten. *8)
  2204.           ENDIF
  2205.           '
  2206.           mv!(jj%)=TRUE                          ! No point in going around again.
  2207.           EXIT IF mv!(jj%)                       ! Got info so exit loop.
  2208.           '
  2209.         ENDIF
  2210.       NEXT kk%
  2211.       '
  2212.       mv!(jj%)=FALSE                           ! Reset for next time.
  2213.     ENDIF
  2214.     '
  2215.   next_group:
  2216.   NEXT jj%
  2217. RETURN
  2218. > PROCEDURE g_bigfile(g_big$,g_max%)
  2219.   FOR i%=0 TO grp%-1
  2220.     IF INSTR(group$,group$(i%))>0
  2221.       IF g_bigfile$(i%)<>g_big$
  2222.         g_bigfile$(i%)=g_big$
  2223.         g_max%(i%)=g_max%
  2224.       ENDIF
  2225.     ENDIF
  2226.   NEXT i%
  2227. RETURN
  2228. > PROCEDURE g_smallfile(g_small$,g_min%)
  2229.   FOR i%=0 TO grp%-1
  2230.     IF INSTR(group$,group$(i%))>0
  2231.       IF g_smallfile$(i%)<>g_small$
  2232.         g_smallfile$(i%)=g_small$
  2233.         g_min%(i%)=g_min%
  2234.       ENDIF
  2235.     ENDIF
  2236.   NEXT i%
  2237. RETURN
  2238.